home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 008 / clockcal.arc / CALENDAR.BAS next >
Encoding:
BASIC Source File  |  1986-10-01  |  3.5 KB  |  76 lines
  1. 10    EPON$  = CHR$(14)       ' Control code to turn Expanded mode ON
  2. 20    EPOFF$ = CHR$(20)       ' Control code to turn Expanded mode OFF
  3. 30    EMON$  = CHR$(27)+"E"   ' Control code to turn Emphasized mode ON
  4. 40    EMOFF$ = CHR$(27)+"F"   ' Control code to turn Emphasized mode OFF
  5. 50    DATA 31,28,31,30,31,30,31,31,30,31,30,31
  6. 60    DATA "JANUARY","FEBRUARY","MARCH","APRIL","MAY","JUNE","JULY","AUGUST","SEPTEMBER","OCTOBER","NOVEMBER","DECEMBER"
  7. 70    DIM FDOM(12), ARY(3,6,6), LOM(12), NOM$(12), TMP$(3)
  8. 80    DOW$="SU MO TU WE TH FR SA"
  9. 90    SP = 21
  10. 100   IF EPON$ = "" THEN SP = 1
  11. 110   CLS : KEY OFF : RESTORE
  12. 120   FOR I = 1 TO 12 : READ LOM(I) : NEXT I
  13. 130   FOR I = 1 TO 12 : READ NOM$(I) : NEXT I
  14. 140   INPUT "Please enter the year : ",YEAR
  15. 150   IF YEAR <= 0 THEN GOTO 110
  16. 160   LOCATE 2,1 : PRINT "Send to printer ?(Y/N)  ";
  17. 170   YN$ = INKEY$ : IF YN$="" THEN GOTO 170
  18. 180   IF YN$<>"Y" AND YN$<>"y" AND YN$<>"N" AND YN$<>"n" THEN GOTO 160
  19. 190   PRINT YN$
  20. 200   STP = 0 : IF YN$="Y" OR YN$="y" THEN STP = 1
  21. 210   H$ = ""
  22. 220   FOR I = 1 TO 32
  23. 230       H$ = H$ + " "
  24. 240   NEXT I
  25. 250   H$ = H$ + "CALENDAR OF" + STR$(YEAR)
  26. 260   PRINT H$ : PRINT : PRINT : IF STP THEN H$=MID$(H$,SP) : LPRINT EPON$+EMON$+H$+EMOFF$+EPOFF$ : LPRINT : LPRINT
  27. 270   Q = YEAR - 1 + INT((YEAR-1)/4) - INT((YEAR-1)/100) + INT((YEAR-1)/400) + 1
  28. 280   FDOM(1) = Q - INT(Q/7) * 7
  29. 290   IF INT(YEAR/4)  *  4-YEAR = 0 THEN LOM(2) = 29
  30. 300   IF INT(YEAR/100)*100-YEAR = 0 THEN LOM(2) = 28
  31. 310   IF INT(YEAR/400)*400-YEAR = 0 THEN LOM(2) = 29
  32. 320   FOR I = 2 TO 12
  33. 330       FDOM(I) = FDOM(I-1) + LOM(I-1) - 28
  34. 340       WHILE FDOM(I) >= 7
  35. 350           FDOM(I) = FDOM(I) - 7
  36. 360       WEND
  37. 370   NEXT I
  38. 380   P2$ = "     " + DOW$ + "     " + DOW$ + "     " + DOW$
  39. 390   FOR LOOP = 1 TO 4
  40. 400       FOR I = 1 TO 3 : FOR J = 1 TO 6 : FOR K = 0 TO 6 : ARY(I,J,K) = 0 : NEXT K : NEXT J : NEXT I
  41. 410       FOR MO = 1 TO 3
  42. 420           WK = 1 : K = 3*LOOP-3+MO : J = FDOM(K)
  43. 430           FOR DATE = 1 TO LOM(K)
  44. 440               ARY(MO,WK,J) = DATE
  45. 450               J = J + 1 : IF J > 6 THEN J = 0 : WK = WK + 1
  46. 460           NEXT DATE
  47. 470       NEXT MO
  48. 480       X = LOOP*3-2 : P1$ = ""
  49. 490       FOR I = 1 TO 70 : P1$ = P1$ + " " : NEXT I
  50. 500       MID$(P1$,16-LEN(NOM$(X))/2) = NOM$(X) : MID$(P1$,41-LEN(NOM$(X+1))/2) = NOM$(X+1) : MID$(P1$,66-LEN(NOM$(X+2))/2) = NOM$(X+2)
  51. 510       PRINT : PRINT : IF STP THEN LPRINT : LPRINT
  52. 520       PRINT P1$ : PRINT : IF STP THEN LPRINT EMON$+P1$+EMOFF$ : LPRINT
  53. 530       PRINT P2$ : IF STP THEN LPRINT P2$
  54. 540       FOR PLOOP = 1 TO 6
  55. 550           FOR I = 1 TO 3 : TMP$(I) = "" : NEXT I : TTOUT$ = ""
  56. 560           FOR QLOOP = 1 TO 3
  57. 570               FOR RLOOP = 0 TO 6
  58. 580                   CT = ARY(QLOOP,PLOOP,RLOOP) : AT$ = STR$(CT)
  59. 590                   IF CT < 10 THEN AT$ = " " + STR$(CT)
  60. 600                   IF CT = 0  THEN AT$ = "   "
  61. 610                   TMP$(QLOOP) = TMP$(QLOOP) + AT$
  62. 620               NEXT RLOOP
  63. 630           NEXT QLOOP
  64. 640           TTOUT$ = "    " + TMP$(1) + "    " + TMP$(2) + "    " + TMP$(3)
  65. 650           PRINT TTOUT$ : IF STP THEN LPRINT TTOUT$
  66. 660       NEXT PLOOP
  67. 670   NEXT LOOP
  68. 680   PRINT:PRINT:PRINT
  69. 690   LOCATE 24,1 : PRINT "Restart or Exit (R/E) ";
  70. 700   YN$ = INKEY$ : IF YN$ = "" THEN GOTO 690
  71. 710   IF YN$<>"R" AND YN$<>"r" AND YN$<>"E" AND YN$<>"e" THEN GOTO 690
  72. 720   PRINT YN$
  73. 730   IF YN$="R" OR YN$="r" THEN GOTO 110
  74. 740   IF YN$="E" OR YN$="e" THEN SYSTEM
  75. 750   GOTO 690
  76.